﻿
'这里是控件主模块 ==================
'  VisualFreeBasic 控件工作流程
'VFB启动时扫描控件文件夹里的每个文件夹，每个文件夹其中一个为 控件DLL，也就是本工程生产的DLL
'第1步：动态加载DLL
'第2步：检查DLL输出函数，都存在继续下一步，否则认为不是 控件DLL 就卸载DLL
'第3步：调用  initialization  来确定协议版本，不符合的就VFB会提示需要多少版本的。并且卸载DLL
'第4步：调用  SetControlProperty 由 DLL来加载控件属性
'当打开一个工程用到本控件时，调用 Edit_AddControls 加载控件到 窗口编辑器
'用户修改或加载控件后，调用 Edit_SetControlProperty 来设置 窗口编辑器中控件 属性
'若控件有特殊属性需要在线处理，调用 Edit_ControlPropertyAlter 来设置，此时由本DLL负责处理，比如 菜单编辑
'当虚拟控件需要绘画时，调用 Edit_OnPaint 来画控件，实体控件是系统负责画，就不需要了。
'编译软件时，调用 Compile_ExplainControl 解析控件，把控件属性翻译成具体代码。
'而控件类是提供给代码调用的。


Function initialization() As Long Export '初始化
                        '当 VFB5 主软件加载本DLL后，主动调用一下此函数，可以在此做初始化代码
   SetFunctionAddress() '设置函数地址
   Function = 7 '返回协议版本号，不同协议（发生接口变化）不能通用，会发生崩溃等问题，因此VFB主软件会判断此版本号，不匹配就不使用本控件。
End Function
Function SetControlProperty(ByRef ColTool As ColToolType) As Long Export '设置控件工具属性。
   '处理多国语言 -----  如果本控件不支持多国语言，可以删除
   Dim op     As pezi Ptr     = GetOpAPP()
   Dim ExeApp As APP_TYPE Ptr = GetExeAPP()
   vfb_LoadLanguage(ExeApp->Path & "Languages\" & op->Languages & "\Languages.txt" ,App.EXEName)
   
   '设置控件基本属性 --------------
   ColTool.sName     = "ToolBar" 'Name      控件名称，必须英文
   ColTool.sTips     = vfb_LangString("工具栏，永远在窗口顶部，仅次于顶部菜单") 'Tips      鼠标停留在控件图标上提示的内容
   ColTool.uName     = UCase(ColTool.sName)
   ColTool.sVale     = &HE682                     'Ico       字体图标的字符值，字体文件在：VisualFreeBasic5\Settings\iconfont.ttf  如果有 *.ico 文件则优先显示图标文件，而不是字体图标。
   ColTool.Feature   = 2                          'Feature   特征 =0 不使用 =1 主窗口(只能有1个，且永远在第一个) =2 普通控件（有窗口句柄） =3 虚拟控件有界面（无句柄） =4 虚拟控件无界面（组件）
   ColTool.ClassFile = "ClsToolBar.inc"           'ClassFile 控件类文件名
   ColTool.Only      = 01                         'Only      是否是唯一的，就是一个窗口只能有1个此控件
   ColTool.GROUP     = vfb_LangString("常用控件") 'Group     分组名称，2个中文到4个最佳，属于多个分组，用英文豆号分割
   
   '设置控件的属性（窗口编辑器里的属性和选项，写代码的属性是控件类负责，代码提示则在帮助里修改。）和事件（代码编辑时可选的事件）
   '从配置文件中读取属性和事件，必须保证和DLL同文件下的 Attribute.ini Event.ini 配置文件正常
   '若不想用配置文件，也可以直接用代码赋值配置。
   'language <>0支持多国语言，会去VFB主语言文件里读取语言，修改配置里的文字。
   If AttributeOREvent(ColTool ,True) Then Return -1 '返回 -1 表示发生问题，VFB将会直接退出。
   
   Function = 19 '返回 排序号，控件在 IDE 中控件列表的先后位置，必须从2开始，主窗口 Form=0  Pointer=1 ，其它 2--n  从小到大排列
End Function


Function Edit_AddControls(cw As CWindow Ptr,hParent AS HWND,IDC As ULong ,Caption As CWSTR, x As Long, y As Long, w As Long, h As Long,WndProc As Any Ptr) As HWND Export '增加1个控件 
   '编辑：窗口刚被打开，需要新建，返回新建后的控件窗口句柄
   'cw      基于CWindow创建，这是当前窗口的 CWindow 指针
   'hParent 父窗口句柄
   'IDC     控件IDC号
   'Caption 控件标题
   'xywh    位置
   'WndProc 主窗口处理消息的函数地址(窗口消息回调函数)

   Function = cw->AddControl("Toolbar", hParent, IDC, Caption, , , , , , , , WndProc)

End Function

Function Edit_SetControlProperty(ByRef Control As clsControl, ByRef ColTool As ColToolType, ki As Long) As Long Export '设置控件属性
   '编辑：新创建控件、修改控件属性后，都调用1次
   'Control  窗口中的控件
   'ColTool  当前控件配置和属性
   'ki       被修改的属性索引，=0为全部
   Dim hWndControl As hWnd = Control.nHwnd
   Dim vv As String, cvv As CWSTR, i As Long
   
   For i = 1 To ColTool.plU
      vv = Control.pValue(i) '值是 Utf8 格式
      cvv.UTF8 = YF_Replace(vv, Chr(3, 1), vbCrLf)
      '先设置通用部分
      Select Case ColTool.ProList(i).uName
         Case "CAPTION"
            if ColTool.uName <> "STATUSBAR" Then
               SetWindowTextW hWndControl, cvv.vptr
            End if
            Control.Caption = YF_Replace(vv, Chr(3, 1), vbCrLf)
         Case "ICON"
            Dim pa As String = GetProRunFile(0,4)
            Dim svv As String, fvv As Long = InStr(vv, "|")
            if fvv = 0 Then svv = vv Else svv = Left(vv, fvv -1)
            Dim hIcon As HICON = LoadImage(Null, pa & "images\" & Utf8toStr(svv), IMAGE_ICON, 0, 0, LR_DEFAULTSIZE Or LR_LOADFROMFILE)
            If hIcon Then
               hIcon = AfxSetWindowIcon(hWndControl, ICON_SMALL, hIcon)
               If hIcon Then DestroyIcon(hIcon)
            End If
'         Case "LEFT"
'            If ki = i Then  '只有控件才设置，主窗口不设置
'               Control.nLeft = ValInt(vv)
'               FF_Control_SetLoc hWndControl, AfxScaleX(Control.nLeft), AfxScaleY(Control.nTop)
'            End If
'         Case "TOP"   '只有控件才设置，主窗口不设置
'            If ki = i Then
'               Control.nTop = ValInt(vv)
'               FF_Control_SetLoc hWndControl, AfxScaleX(Control.nLeft), AfxScaleY(Control.nTop)
'            End If
'         Case "WIDTH"
'            If ki = i And ColTool.Feature <> 4 Then
'               Control.nWidth = ValInt(vv)
'               FF_Control_SetSize hWndControl, AfxScaleX(Control.nWidth), AfxScaleY(Control.nHeight)
'            End If
'         Case "HEIGHT"
'            If ki = i And ColTool.Feature <> 4 Then
'               Control.nHeight = ValInt(vv)
'               FF_Control_SetSize hWndControl, AfxScaleX(Control.nWidth), AfxScaleY(Control.nHeight)
'            End If
         Case "CHILD"
         Case "MOUSEPOINTER"
         Case "FORECOLOR"
            Control.ForeColor = GetColorText(vv)
         Case "BACKCOLOR"
            Control.BackColor = GetColorText(vv)
         Case "ACCEPTFILES"
         Case "FONT"
            Dim tFont As HFONT = GetWinFontLog(vv)
            SendMessage hWndControl, WM_SETFONT, Cast(wParam, tFont), True
            Control.Font = vv
         Case "TOOLTIPBALLOON"
         Case "TOOLTIP"
'==============     以上是公共设置，下面是每个控件私有设置    =================   
      Case "BSTYLE"  '\边框\2\指示控件边界的外观和行为。\0 - 无边框\0 - 无边框,1 - 细边框,2 - 半边框,3 - 凹边框,4 - 凸边框
         Select Case ValUInt(vv)
            Case 0  '无边框
               AfxRemoveWindowStyle hWndControl, WS_BORDER
               AfxRemoveWindowExStyle hWndControl, WS_EX_CLIENTEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_STATICEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_DLGMODALFRAME
            Case 1  '细边框
               AfxAddWindowStyle hWndControl, WS_BORDER
               AfxRemoveWindowExStyle hWndControl, WS_EX_CLIENTEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_STATICEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_DLGMODALFRAME
            Case 2  '半边框
               AfxRemoveWindowStyle hWndControl, WS_BORDER
               AfxRemoveWindowExStyle hWndControl, WS_EX_CLIENTEDGE
               AfxAddWindowExStyle hWndControl, WS_EX_STATICEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_DLGMODALFRAME
            Case 3  '凹边框
               AfxRemoveWindowStyle hWndControl, WS_BORDER
               AfxAddWindowExStyle hWndControl, WS_EX_CLIENTEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_STATICEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_DLGMODALFRAME
            Case 4 ' 凸边框
               AfxRemoveWindowStyle hWndControl, WS_BORDER
               AfxRemoveWindowExStyle hWndControl, WS_EX_CLIENTEDGE
               AfxRemoveWindowExStyle hWndControl, WS_EX_STATICEDGE
               AfxAddWindowExStyle hWndControl, WS_EX_DLGMODALFRAME
         End Select
      Case "BUTTON"  '
         
      Case "IMAGESSIZE"  '\图像尺寸\2\设置按钮图像的尺寸\SIZE_24\SIZE_16,SIZE_24,SIZE_32,SIZE_48
         'If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, MCS_WEEKNUMBERS Else AfxRemoveWindowStyle hWndControl, MCS_WEEKNUMBERS
      Case "FLAT"  '\平面按钮\2\创建一个平面工具栏。在平面工具栏中，工具栏和按钮都是透明的，热跟踪功能已启用。\True\True,False
         If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, TBSTYLE_FLAT Else AfxRemoveWindowStyle hWndControl, TBSTYLE_FLAT
      Case "LIST"  '\右侧位图\2\创建位图右侧的按钮文本的平面工具栏。\False\True,False
         If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, TBSTYLE_LIST Else AfxRemoveWindowStyle hWndControl, TBSTYLE_LIST
      Case "TOOLTIPS"  '\提示\2\创建一个工具提示控件，应用程序可以使用该控件来显示工具栏中按钮的描述性文本。\True\True,False
         If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, TBSTYLE_TOOLTIPS Else AfxRemoveWindowStyle hWndControl, TBSTYLE_TOOLTIPS
      Case "TRANSPARENT"  '\透明\2\创建透明工具栏。在透明工具栏中，工具栏是透明的，但按钮不是。按钮文本显示在按钮位图下方。\False\True,False
         If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, TBSTYLE_TRANSPARENT Else AfxRemoveWindowStyle hWndControl, TBSTYLE_TRANSPARENT
      Case "WRAPABLE"  '\多行按钮\2\创建一个可以有多行按钮的工具栏。当工具栏变得太窄而不能包含同一行上的所有按钮时，工具栏按钮可以“换行”到下一行。\False\True,False
         If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, TBSTYLE_WRAPABLE Else AfxRemoveWindowStyle hWndControl, TBSTYLE_WRAPABLE
      Case "LISTGAP"
         'SendMessage(hWndControl, WM_USER + 96, AfxScaleX(Val(vv)), 0)   '默认为 SendMessageW
         'SendMessageW(hWndControl, TB_SETLISTGAP, gap, 0)
         'ToolBar_SetListGap hWndControl,AfxScaleX (Val(vv))
      Case "INDENT"
         ToolBar_SetIndent hWndControl, AfxScaleX(Val(vv))
      Case "TAG"
         SendMessage(hWndControl, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS Or TBSTYLE_EX_MIXEDBUTTONS)   '默认为 SendMessageW
         
         Dim wi As Long = GetColToolProIndex(ColTool, "IMAGESSIZE")
         Dim imSize As Long
         if wi Then imSize = AfxScaleX(ValInt(Mid(Control.pValue(wi), 6)))
         if imSize < AfxScaleX(16) then imSize = AfxScaleX(16)
         
         wi = GetColToolProIndex(ColTool, "BUTTON")
         if wi then
            Dim uu As Long = ToolBar_ButtonCount(hWndControl)
            if uu > 0 then
               for ii as Long = 1 To uu
                  ToolBar_DeleteButton hWndControl, 0
               Next
            end if
            Dim siml As HIMAGELIST = ToolBar_GetImageList(hWndControl)
            if siml Then ImageList_Destroy siml
            siml = ImageList_Create(imSize, imSize, ILC_COLOR32, uu + 1, 1)
            'ToolBar_SetImageList (hWndControl, 0, siml)
            SendMessage(hWndControl, TB_SETIMAGELIST, 0, cast(lParam, siml))   '默认为 SendMessageW
            Dim ss As String = trim(Control.pValue(wi))
            Dim ppn() As TBBUTTON, ppi As Long
            if Len(ss) > 0 Then
               Dim el() As String
               uu = vbSplit(ss, chr(1), el())
               for ii As Long = 0 To uu -1
                  el(ii) = Trim(el(ii))
                  if Len(el(ii)) Then
                     Dim sl() As String
                     Dim uu2 As Long = vbSplit(el(ii), chr(2), sl())
                     if uu2 > 10 Then
                        Dim Imgi As Long = -1
                        if valint(sl(3)) = 4 Then
                           'Toolbar_AddSeparator hWndControl
                           ReDim Preserve ppn(ppi)
                           ppn(ppi).fsStyle = TBSTYLE_SEP
                           ppi += 1
                        Else
                           if len(sl(4)) Then
                              Dim nIcon AS HICON = ImgFileToIcon(sl(4))
                              Imgi = ImageList_ReplaceIcon(siml, -1, nIcon)
                           End if
                           Dim As ULong fsState ,fSStyle
                           if valint(sl(7)) <> 0 Then fsState Or= TBSTATE_CHECKED
                           if valint(sl(8)) <> 0 Then fsState Or= TBSTATE_ENABLED
                           if valint(sl(9)) <> 0 Then fsState Or= TBSTATE_HIDDEN
                           if valint(sl(10)) <> 0 Then fsState Or= TBSTATE_ELLIPSES
                           Select Case valint(sl(3))
                              Case 0 : fSStyle = BTNS_BUTTON
                              Case 1 : fSStyle = BTNS_CHECK
                              Case 2 : fSStyle = BTNS_CHECKGROUP
                              Case 3 : fSStyle = BTNS_DROPDOWN
                           End Select
                           if valint(sl(5)) <> 0 Then fSStyle Or= BTNS_AUTOSIZE
                           if valint(sl(6)) <> 0 Then fSStyle Or= BTNS_SHOWTEXT
                           'Toolbar_AddButton hWndControl, Imgi, 0, fsState, fSStyle, 0, Utf8toStr(sl(1))
                           ReDim Preserve ppn(ppi)
                           ppn(ppi).iBitmap = Imgi
                           ppn(ppi).idCommand = 0
                           ppn(ppi).fsState = fsState
                           ppn(ppi).fsStyle = fsStyle
                           ppn(ppi).dwData = 0
                           Dim mws As CWSTR = Utf8toStr(sl(1))
                           Dim wws As WString * 20 = mws 
                           Dim wwp As Any Ptr = CAllocate(42)
                           memcpy wwp,@wws,40
                           ppn(ppi).iString =Cast(INT_PTR, wwp )
                           ppi += 1
                        end if
                        'ToolEditList(si).IDCname = sl(0)    ' utf8 格式  代码里的名字
                        'ToolEditList(si).zText = sl(1)  '  utf8 格式  菜单文字
                        'ToolEditList(si).nTips = sl(2)     'utf8 格式  提示文字
                        'ToolEditList(si).tbStyle = valint(sl(3))  '样式 0普通按钮 1多选按钮 2单选按钮 3下拉列表  4分割线
                        'ToolEditList(si).nIco = sl(4)     'utf8 格式 图标
                        'ToolEditList(si).AutoSize = valint(sl(5))   ' 自动调整大小
                        'ToolEditList(si).ShowText = valint(sl(6))   ' 显示文本
                        'ToolEditList(si).xChecked = valint(sl(7))   '被选择
                        'ToolEditList(si).xEnabled = valint(sl(8))  '可用
                        'ToolEditList(si).xHidden = valint(sl(9))   '隐藏
                        'ToolEditList(si).xEllipses = valint(sl(10)) ' 省略号
                     End if
                  End if
               Next
            End if
            if ppi > 0 Then 
               SendMessageW( hWndControl , TB_ADDBUTTONS , ppi ,Cast(lParam, @ppn(0)))   '默认为 SendMessageW
               for ii As Long = 0  To ppi -1
                  if ppn(ii).iString Then Deallocate  Cast(Any Ptr, ppn(ii).iString )
               Next    
            End if   
            ToolBar_AutoSize hWndControl
            'SendMessageW hWndControl, TB_AUTOSIZE, 0, 0
'            FF_Control_GetSize hWndControl, Control.nWidth, Control.nHeight
'            FF_Control_GetLoc hWndControl, Control.nLeft, Control.nTop
            
            
         end if

      End Select
   Next
   Function = 0
End Function
Function Edit_SetControlEvent(ByRef Control As clsControl ,ByRef ColTool As ColToolType ,ByRef ucc As String ,ByRef ss As String) As Long Export '设置控件额外的事件代码
   '编辑：新键控件的事件时，是否需要添加额外的事件代码
   'Control  窗口中的控件,不可修改内容
   'ColTool  控件类型,不可修改内容
   'ucc      大写的，事件名称（窗口名+控件名+事件名） 不要修改这个内容
   'ss       要添加的事件代码，会插入到事件代码里
   '返回     0 不添加额外的事件代码，非0 添加代码
   If InStr(ucc ,"_COMMAND") > 0 Then
      Dim wi As Long = GetColToolProIndex(ColTool ,"BUTTON")
      If wi > 0 Then
         If Len(Control.PVALUE(wi)) > 0 Then
            ss &= "   Select Case wID" & vbCrLf
            Dim mi   As Long
            Dim el() As String ,ftvi As Long
            Dim meu  As Long = vbSplit(Control.PVALUE(wi) ,!"\&h01" ,el())
            For mi = 0 To meu -1
               el(mi) = Trim(el(mi))
               If Len(el(mi)) Then
                  Dim sl() As String
                  Dim uu   As Long = vbSplit(el(mi) ,!"\&h02" ,sl())
                  If uu > 4 Then
                     ss &= "      Case " & sl(0) & " ' " & sl(1) & vbCrLf & vbCrLf
                  End If
               End If
            Next
            ss &= "   End Select" & vbCrLf
            Return 1
         End If
      End If
   End If
   If InStr(ucc ,"_TBN_DROPDOWN") > 0  Then
      Dim wi As Long = GetColToolProIndex(ColTool ,"BUTTON")
      If wi > 0 Then
         If Len(Control.PVALUE(wi)) > 0 Then
            ss &= "   Select Case pNMTB.iItem" & vbCrLf
            Dim mi   As Long
            Dim el() As String ,ftvi As Long
            Dim meu  As Long = vbSplit(Control.PVALUE(wi) ,!"\&h01" ,el())
            For mi = 0 To meu -1
               el(mi) = Trim(el(mi))
               if Len(el(mi)) Then
                  Dim sl() As String
                  Dim uu   As Long = vbSplit(el(mi) ,chr(2) ,sl())
                  if uu > 4 Then
                     ss &= "      Case " & sl(0) & " ' " & sl(1) & vbCrLf & vbCrLf
                  End if
               End if
            Next
            ss &= "   End Select" & vbCrLf
         End if
      End if
   End If
   Function = 0
End Function

Function Edit_ControlPropertyAlter(hWndForm As hWnd, hWndList As hWnd, nType As Long, value As String, default As String, AllList As String, nName As String, FomName As String) As Long Export  ' 控件属性修改
   '编辑：用户点击窗口属性，修改属性时，1--6由EXE处理，7 或其它由本DLL处理
   'hWndForm   EXE 主窗口句柄
   'hWndList   控件属性显示窗口句柄（是List控件）Dim z As ZString Ptr = Cast(Any Ptr ,FF_ListBox_GetItemData(aa.hWndList,Index)) '当前属性值
   'nType      类型，由 Attribute.ini 里设置，7 或其它由本DLL处理
   'value      当前的值
   'default    默认值，由 Attribute.ini 里设置
   'AllList    所有值，由 Attribute.ini 里设置
   Select Case nType  '这里根据需要编写
      Case 100
         Dim aa As StyleFormType
         aa.hWndForm = hWndForm
         aa.hWndList = hWndList
         aa.nType = nType
         aa.value = @value
         aa.default = @default
         aa.AllList = @AllList
         aa.Rvalue = value
         aa.nName = nName : aa.FomName = FomName '当前被编辑的控件名和窗口名
         ToolEdit.Show hWndForm, True, Cast(Integer, @aa)
         value = aa.Rvalue
         Function = Len(value)
         
   End Select
End Function
Function Edit_OnPaint(gg As yGDI, Control As clsControl, ColTool As ColToolType, WinCc As Long, nFile As String) as Long Export '描绘控件
   '编辑：当被刷新窗口，需要重绘控件时，窗口和实控件由系统绘画，不需要我们在这里处理，虚拟控件必须由此画出来。
   'gg    目标， 画在这个缓冲里。
   'Control  窗口中的控件
   'ColTool  当前控件配置和属性
   'WinCc    主窗口底色，不是本控件底色
   'nFile    当前工程主文件名，带文件夹，用来提取路径用。
   '返回非0  将会立即结束描绘操作，就是在此之后的控件就不会画了。按照最底层的控件先画。
   
  
   Function = 0
End Function
Function Compile_ExplainControl(Control As clsControl ,ColTool As ColToolType ,ProWinCode As String ,ussl() As String ,ByRef IDC As Long ,DECLARESdim As String ,Form_clName as String ,nFile As String) as Long Export '解释控件，制造创建控件和事件的代码
   '编译：解释控件 ，注意：编译处理字符全部为 UTF8 编码。Control和ColTool里的是 A字符。
   'Control      窗口中的控件
   'ColTool      当前控件配置和属性
   'ProWinCode   处理后的窗口代码，最初由窗口加载窗口模板处理，然后分发给其它控件。填充处理
   'ussl()       已特殊处理过的用户写的窗口代码，主要用来识辨事件
   'IDC          控件IDC，每个控件唯一，VFB自动累计1，我们代码也可以累计
   'DECLARESdim  全局变量定义，整个工程的定义都在此处
   'Form_clName  主窗口类名，最初由窗口设置，方便后面控件使用。
   'nFile        窗口文件名，用在事件调用注释，出错时可以提示源文件地方，避免提示临时文件。
   
   
   '创建控件 ------------------------------
   Dim ii As Long
   Dim As String clClName ,clName ,clStyle ,clExStyle ,clPro
   
   Dim As Long clType '为了解释代码里用，>=100 为虚拟控件  100=LABEL 1=TEXT
   clName = StrToUtf8(Control.nName)
   If Control.Index > -1 Then clName &= "(" & Control.Index & ")"
   clClName  = "TOOLBAR"
   clType    = 0
   clStyle   = "WS_CHILD,WS_CLIPCHILDREN,WS_CLIPSIBLINGS,CCS_TOP"
   clExStyle = ""
   Dim As Long MENUmin ,MENUmax '工具栏需要
   
   For ii = 1 To ColTool.plU
      if ExplainControlPublic(Form_clName ,Control ,clName ,ii ,ColTool.ProList(ii).uName ,clType ,clStyle ,clExStyle ,clPro ,ProWinCode) Then '处理公共部分，已处理返回0，未处理返回非0
         Select Case ColTool.ProList(ii).uName
               'Case "NAME"  '名称\1\用来代码中识别对象的名称
               'Case "INDEX"  '数组索引\0\控件数组中的控件位置的索引数字。值小于零表示不是控件数组
               'Case "CAPTION"  '文本\1\显示的文本\Label\
               'Case "TEXT"  '文本\1\显示的文本\Label\
               'Case "ENABLED"  '允许\2\创建控件时最初是否允许操作。\True\True,False
               'Case "VISIBLE"  '显示\2\创建控件时最初是显示或隐藏。\True\True,False
               'Case "FORECOLOR"  '文字色\3\用于在对象中显示文本和图形的前景色。\SYS,8\
               'Case "BACKCOLOR"  '背景色\3\用于在对象中显示文本和图形的背景色。\SYS,15\
               'Case "FONT"  '字体\4\用于此对象的文本字体。\微软雅黑,9,0\
               'Case "LEFT"  '位置X\0\左边缘和父窗口的左边缘之间的距离。自动响应DPI缩放\0\
               'Case "TOP"  '位置Y\0\内部上边缘和父窗口的顶部边缘之间的距离。自动响应DPI缩放\0\
               'Case "WIDTH"  '宽度\0\窗口宽度，100%DPI时的像素单位，自动响应DPI缩放。\100\
               'Case "HEIGHT"  '高度\0\窗口高度，100%DPI时的像素单位，自动响应DPI缩放。\20\
               'Case "LAYOUT"
               'Case "MOUSEPOINTER"  '鼠标指针\2\鼠标在窗口上的形状\0 - 默认\0 - 默认,1 - 后台运行,2 - 标准箭头,3 - 十字光标,4 - 箭头和问号,5 - 文本工字光标,6 - 不可用禁止圈,7 - 移动,8 - 双箭头↙↗,9 - 双箭头↑↓,10 - 双箭头向↖↘,11 - 双箭头←→,12 - 垂直箭头,13 - 沙漏,14 - 手型
               'Case "TAG"  '附加\1\私有自定义文本与控件关联。\\
               'Case "TAB"  '导航\2\当用户按下TAB键时可以接收键盘焦点。\False\True,False
               'Case "TOOLTIP"  '提示\1\一个提示，当鼠标光标悬停在控件时显示它。\\
               'Case "TOOLTIPBALLOON"  '气球样式\2\一个气球样式显示工具提示。\False\True,False
               'Case "ACCEPTFILES"  '拖放\2\窗口是否接受拖放文件。\False\True,False
               '==============     以上是公共设置，下面是每个控件私有设置    =================
            Case "BSTYLE" '\边框\2\指示控件边界的外观和行为。\0 - 无边框\0 - 无边框,1 - 细边框,2 - 半边框,3 - 凹边框,4 - 凸边框
               Select Case ValUInt(Control.pValue(ii))
                  Case 0 '无边框
                  Case 1 '细边框
                     clStyle = TextAddWindowStyle(clStyle ,"WS_BORDER")
                  Case 2 '半边框
                     clExStyle = TextAddWindowStyle(clExStyle ,"WS_EX_STATICEDGE")
                  Case 3 '凹边框
                     clExStyle = TextAddWindowStyle(clExStyle ,"WS_EX_CLIENTEDGE")
                  Case 4 ' 凸边框
                     clExStyle = TextAddWindowStyle(clExStyle ,"WS_EX_DLGMODALFRAME")
               End Select
            Case "IMAGESSIZE" '\图像尺寸\2\设置按钮图像的尺寸\SIZE_24\SIZE_16,SIZE_24,SIZE_32,SIZE_48
               'If UCase(vv) = "TRUE" Then AfxAddWindowStyle hWndControl, MCS_WEEKNUMBERS Else AfxRemoveWindowStyle hWndControl, MCS_WEEKNUMBERS
            Case "FLAT" '\平面按钮\2\创建一个平面工具栏。在平面工具栏中，工具栏和按钮都是透明的，热跟踪功能已启用。\True\True,False
               If UCase(Control.pValue(ii)) = "TRUE" Then clStyle = TextAddWindowStyle(clStyle ,"TBSTYLE_FLAT")
            Case "LIST" '\右侧位图\2\创建位图右侧的按钮文本的平面工具栏。\False\True,False
               If UCase(Control.pValue(ii)) = "TRUE" Then clStyle = TextAddWindowStyle(clStyle ,"TBSTYLE_LIST")
            Case "TOOLTIPS" '\提示\2\创建一个工具提示控件，应用程序可以使用该控件来显示工具栏中按钮的描述性文本。\True\True,False
               If UCase(Control.pValue(ii)) = "TRUE" Then clStyle = TextAddWindowStyle(clStyle ,"TBSTYLE_TOOLTIPS")
            Case "TRANSPARENT" '\透明\2\创建透明工具栏。在透明工具栏中，工具栏是透明的，但按钮不是。按钮文本显示在按钮位图下方。\False\True,False
               If UCase(Control.pValue(ii)) = "TRUE" Then clPro &= "      AfxAddWindowStyle hWndControl, TBSTYLE_TRANSPARENT" & vbCrLf Else clPro &= "      AfxRemoveWindowStyle hWndControl, TBSTYLE_TRANSPARENT" & vbCrLf
            Case "WRAPABLE" '\多行按钮\2\创建一个可以有多行按钮的工具栏。当工具栏变得太窄而不能包含同一行上的所有按钮时，工具栏按钮可以“换行”到下一行。\False\True,False
               If UCase(Control.pValue(ii)) = "TRUE" Then clStyle = TextAddWindowStyle(clStyle ,"TBSTYLE_WRAPABLE")
            Case "INDENT"
               clPro &= "      ToolBar_SetIndent hWndControl, AfxScaleX(" & Control.pValue(ii) & ") " & vbCrLf
            Case "BUTTON"
               clPro &= "      SNDMSG(hWndControl,TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS Or TBSTYLE_EX_MIXEDBUTTONS) " & vbCrLf
               Dim wi     As Long = GetColToolProIndex(ColTool ,"IMAGESSIZE")
               Dim imSize As Long
               if wi          Then imSize = ValInt(Mid(Control.pValue(wi) ,6))
               if imSize < 16 then imSize = 16
               clPro &= "      This." & clName & ".SetImgSize AfxScaleX(" & imSize & ")" & vbCrLf
               Dim ss As String = trim(Control.pValue(ii))
               MENUmin = IDC
               if Len(ss) > 0 Then
                  Dim el() As String
                  Dim uu   As Long = vbSplit(ss ,chr(1) ,el())
                  for buti As Long = 0 To uu -1
                     el(buti) = Trim(el(buti))
                     if Len(el(buti)) Then
                        Dim sl() As String
                        Dim uu2  As Long = vbSplit(el(buti) ,chr(2) ,sl())
                        If uu2 > 10 Then
                           DECLARESdim &= "#define " & sl(0) & " " & IDC & vbCrLf
                           IDC   += 1
                           sl(4) = *FileToResourceName(sl(4))
                           If IsMultiLanguage() Then 'IsMultiLanguage 后面加()才表示使用函数，不然就是函数指针。
                              clPro &= "      This." & clName & ".AddButton(" & sl(0) & ",""" & sl(4) & """,vfb_LangString(""" & sl(1) & """),vfb_LangString(""" & sl(2) & """)," & sl(3) & "," & sl(5) & "," & sl(6) & "," & sl(7) & "," & sl(8) & "," & sl(9) & "," & sl(10) & ")" & vbCrLf
                           Else
                              clPro &= "      This." & clName & ".AddButton(" & sl(0) & ",""" & sl(4) & """,""" & sl(1) & """,""" & sl(2) & """," & sl(3) & "," & sl(5) & "," & sl(6) & "," & sl(7) & "," & sl(8) & "," & sl(9) & "," & sl(10) & ")" & vbCrLf
                           End if
                        End if
                     End if
                  Next
               End if
               MENUmax = IDC
               Dim CONTROLS_NOTIFY As String = "         If FLY_pNotify->Code = TTN_NEEDTEXT Then" & vbCrLf
               CONTROLS_NOTIFY &= "            If FLY_pNotify->idFrom >= " & MENUmin & " And FLY_pNotify->idFrom <= " & MENUmax & " Then" & vbCrLf
               CONTROLS_NOTIFY &= "               Dim FLY_lpToolTip As TOOLTIPTEXTW Ptr = Cast(Any Ptr, lParam) " & vbCrLf
               CONTROLS_NOTIFY &= "               FLY_lpToolTip->szText = " & Form_clName & "." & clName & ".ButtonTips(FLY_pNotify->idFrom)" & vbCrLf
               CONTROLS_NOTIFY &= "            End If"                      & vbCrLf
               CONTROLS_NOTIFY &= "         End If"
               Insert_code(ProWinCode ,"'[CONTROLS_NOTIFY]" ,CONTROLS_NOTIFY)
         End Select
      End if
   Next
   
   
   
   Insert_code(ProWinCode ,"'[CONTROL_WM_SIZE]" , _
      "            SetWindowPos( GetDlgItem(hWndForm," & IDC & "), 0, 0, 0, LoWord(lParam), AfxScaleY(" & Control.nHeight & "),SWP_NOZORDER Or SWP_NOMOVE or SWP_NOACTIVATE)" & vbCrLf)
   
   
   Insert_code(ProWinCode ,"'[CALL_CONTROL_DESTROY]" , _  '控件窗口销毁事件，用于真实控件，处理清理工作
      "               Case " & IDC & vbCrLf & _
      "                  " & Form_clName & "." & clName & ".HWnd= hWndControl" & vbCrLf & _
      "                  " & Form_clName & "." & clName & ".UnLoadControl() " & vbCrLf)

      
         
   Dim CONTROL_CODExx As String
   If Len(clExStyle) = 0 Then clExStyle = "0"
   If Len(clStyle) = 0   Then clStyle   = "0"
   
   '真实控件========
   Dim CaptionTxt As String = GetTextToOutText(Control.Caption) '为编译输出文本转换输出文本，可能是多国语言，转换为多国语言字符
   CONTROL_CODExx &= "   hWndControl = pWindow->AddControl(""" & clClName & """, hWnd, " & IDC & "," & CaptionTxt & ", " & _
      Control.nLeft          & ", "        & Control.nTop       & ", " & Control.nWidth & ", " & Control.nHeight & "," & YF_Replace(clStyle ,"," ," Or ") & " ," & YF_Replace(clExStyle ,"," ," Or ") & _
      " , , Cast(Any Ptr, @" & Form_clName & "_CODEPROCEDURE))" & vbCrLf
   CONTROL_CODExx &= "   If hWndControl Then " & vbCrLf
   CONTROL_CODExx &= "      Dim fp As FormControlsPro_TYPE ptr = new FormControlsPro_TYPE" & vbCrLf
   CONTROL_CODExx &= "      vfb_Set_Control_Ptr(hWndControl,fp)"                           & vbCrLf
   CONTROL_CODExx &= "      fp->hWndParent = hWnd"                                         & vbCrLf
   CONTROL_CODExx &= "      fp->Index = "                                                  & Control.Index & vbCrLf
   CONTROL_CODExx &= "      fp->IDC = "                                                    & IDC           & vbCrLf
   CONTROL_CODExx &= "      fp->nText = "                                                  & CaptionTxt    & vbCrLf
   '   CONTROL_CODExx &= "      fp->ControlType = " & clType & vbCrLf
   CONTROL_CODExx &= "      This." & clName & ".hWnd = hWndControl " & vbCrLf '真实控件========
   CONTROL_CODExx &= "      This." & clName & ".IDC ="               & IDC & vbCrLf
   
   CONTROL_CODExx &= clPro
   CONTROL_CODExx &= "   End IF" & vbCrLf
   
   Insert_code(ProWinCode ,"'[Create control]" ,CONTROL_CODExx)
   
   '事件处理 ------------------------------
   Dim LeaveHoverI As Long
   '控件事件
   
   '真实控件事件
   For ii = 1 To ColTool.elU
      Dim sim As String '事件函数名组合
      sim = " " & UCase(Form_clName & "_" & StrToUtf8(Control.nName & "_" & ColTool.EveList(ii).sName)) & "("
      Dim ff As Long
      for fi As Long = 0 To UBound(ussl)
         If left(ussl(fi) ,1) <> "'" AndAlso InStr(ussl(fi) ,sim) > 0 Then
            ff = fi + 1
            Exit for
         End If
      Next
      If ff > 0 Then
         if IsEventComparison(Control ,ColTool ,ii ,ff ,nFile ,ussl(ff -1) ,Form_clName) Then Return 3 '检查事件是不是正确
         Select Case ColTool.EveList(ii).tMsg
            Case "TBN_DROPDOWN" ,"NM_CLICK" ,"NM_DBLCLK" ,"NM_RCLICK" ,"NM_RDBLCLK" ,"NM_CHAR" ,"NM_CUSTOMDRAW" ,"NM_KEYDOWN" ,"NM_LDOWN" , _
               "NM_RELEASEDCAPTURE" ,"NM_TOOLTIPSSCREATED" ,"TBN_BEGINADJUST" ,"TBN_BEGINDRAG" ,"TBN_CUSTHELP" ,"TBN_DELETINGBUTTON" ,"TBN_DRAGOUT" , _
               "TBN_DRAGOVER" ,"TBN_DUPACCELERATOR" ,"TBN_ENDADJUST" ,"TBN_ENDDRAG" ,"TBN_GETBUTTONINFO" ,"TBN_GETDISPINFO" ,"TBN_GETINFOTIP" , _
               "TBN_GETOBJECT" ,"TBN_HOTITEMCHANGE" ,"TBN_INITCUSTOMIZE" ,"TBN_MAPACCELERATOR" ,"TBN_QUERYDELETE" ,"TBN_QUERYINSERT" , _
               "TBN_RESET" ,"TBN_RESTORE","TBN_SAVE","TBN_TOOLBARCHANGE","TBN_WRAPACCELERATOR","TBN_WRAPHOTITEM"
               Dim CONTROLS_NOTIFY As String = "         If (FLY_pNotify->idFrom = " & IDC & ") And (FLY_pNotify->Code = " & ColTool.EveList(ii).tMsg & ") Then" & vbCrLf
               If Right(ColTool.EveList(ii).Param ,1) = ")" Then '是SUB
                  CONTROLS_NOTIFY &= "             " & sim
               Else
                  CONTROLS_NOTIFY &= "             tLResult = " & sim
               End If
               If Control.Index > -1 Then CONTROLS_NOTIFY &= Control.Index & ","
               CONTROLS_NOTIFY &= ColTool.EveList(ii).gCall                      & "  " & nFile & ff -1 & "]" & vbCrLf
               If Right(ColTool.EveList(ii).Param ,1) <> ")" Then CONTROLS_NOTIFY &= "            If tLResult Then Return tLResult" & vbCrLf
               CONTROLS_NOTIFY &= "         End If"
               Insert_code(ProWinCode ,"'[CONTROLS_NOTIFY]" ,CONTROLS_NOTIFY)
            Case "WM_COMMAND" '目前就工具栏需要这个
               Dim CALL_FORM_CUSTOM As String = "   If wMsg = " & ColTool.EveList(ii).tMsg & " Then " & vbCrLf
               CALL_FORM_CUSTOM &= "      Dim wID As ULong = LoWord(wParam)" & vbCrLf
               CALL_FORM_CUSTOM &= "      If wID >= "                        & MENUmin     & " And wID <= " & MENUmax & " Then"                 & vbCrLf
               CALL_FORM_CUSTOM &= "         "                               & Form_clName & "."            & clName  & ".hWndForm = hWndForm " & vbCrLf
               CALL_FORM_CUSTOM &= "        "                                & sim
               If Control.Index > -1 Then CALL_FORM_CUSTOM &= Control.Index & ","
               CALL_FORM_CUSTOM &= ColTool.EveList(ii).gCall & "  " & nFile & ff -1 & "]" & vbCrLf
               CALL_FORM_CUSTOM &= "      End If "           & vbCrLf
               CALL_FORM_CUSTOM &= "   End If "              & vbCrLf
               Insert_code(ProWinCode ,"'[CALL_FORM_CUSTOM]" ,CALL_FORM_CUSTOM)
            Case "CUSTOM"
               dim CALL_CONTROL_CUSTOM As String = "    If IDC = " & IDC & " Then  ' " & clName & vbCrLf
               CALL_CONTROL_CUSTOM &= "       tLResult = " & sim
               If Control.Index > -1 Then CALL_CONTROL_CUSTOM &= Control.Index & ","
               CALL_CONTROL_CUSTOM &= ColTool.EveList(ii).gCall                 & "  " & nFile & ff -1 & "]" & vbCrLf
               CALL_CONTROL_CUSTOM &= "       If tLResult Then Return tLResult" & vbCrLf
               CALL_CONTROL_CUSTOM &= "    End If"                              & vbCrLf
               Insert_code(ProWinCode ,"'[CALL_CONTROL_CUSTOM]" ,CALL_CONTROL_CUSTOM)
            Case Else
               If ColTool.EveList(ii).tMsg = "WM_MOUSEHOVER" Then LeaveHoverI Or= 1
               If ColTool.EveList(ii).tMsg = "WM_MOUSELEAVE" Then LeaveHoverI Or= 10
               Dim ca    As String = "      Case "         & ColTool.EveList(ii).tMsg & " ''' "
               Dim other As String = "          If IDC = " & IDC                      & " Then  ' " & clName & vbCrLf
               If Right(ColTool.EveList(ii).Param ,1) <> ")" Then '这是函数
                  other &= "          tLResult = " & sim
                  If Control.Index > -1 Then other &= Control.Index & ","
                  other &= ColTool.EveList(ii).gCall                    & "  " & nFile & ff -1 & "]" & vbCrLf
                  other &= "          If tLResult Then Return tLResult" & vbCrLf
               Else '这是过程
                  other &= "             " & sim
                  If Control.Index > -1 Then other &= Control.Index & ","
                  other &= ColTool.EveList(ii).gCall & "  " & nFile & ff -1 & "]" & vbCrLf
               End If
               other &= "          End If" & vbCrLf
               ff    = InStr(ProWinCode ,ca)
               If ff = 0 Then '不存在
                  Insert_code(ProWinCode ,"'[CONTROL_CASE_OTHER]" ,ca & vbCrLf & other)
               Else '已经有了
                  ProWinCode = Left(ProWinCode ,ff + Len(ca) -1) & vbCrLf & other & Mid(ProWinCode ,ff + Len(ca))
               End If
         End Select
      End If
   Next
   
   If LeaveHoverI > 0 And LeaveHoverI <> 10 Then '单独=10的离开消息，系统自带，不需要启用
      dim CONTROL_LEAVEHOVER As String = "          If wMsg = WM_MouseMove AndAlso IDC = " & IDC & " Then  ' " & clName & vbCrLf
      CONTROL_LEAVEHOVER &= "             Dim entTrack As tagTRACKMOUSEEVENT"           & vbCrLf
      CONTROL_LEAVEHOVER &= "             entTrack.cbSize = SizeOf(tagTRACKMOUSEEVENT)" & vbCrLf
      If LeaveHoverI = 11 Then
         CONTROL_LEAVEHOVER &= "             entTrack.dwFlags = TME_LEAVE Or TME_HOVER" & vbCrLf
      ElseIf LeaveHoverI = 10 Then
         CONTROL_LEAVEHOVER &= "             entTrack.dwFlags = TME_LEAVE " & vbCrLf
      Else
         CONTROL_LEAVEHOVER &= "             entTrack.dwFlags =  TME_HOVER" & vbCrLf
      End If
      CONTROL_LEAVEHOVER &= "             entTrack.hwndTrack = hWndControl"     & vbCrLf
      CONTROL_LEAVEHOVER &= "             entTrack.dwHoverTime = HOVER_DEFAULT" & vbCrLf
      CONTROL_LEAVEHOVER &= "             TrackMouseEvent @entTrack"            & vbCrLf
      CONTROL_LEAVEHOVER &= "          End IF"                                  & vbCrLf
      Insert_code(ProWinCode ,"'[CONTROL_LEAVEHOVER]" ,CONTROL_LEAVEHOVER)
   End If
   
   '成功返回0，失败非0
   Function = 0
End Function

Function ImgFileToIcon(ByVal ResImg As String) As HICON  '从资源文件获取图标句柄
   Dim nIcon As HICON
   if Len(ResImg)=0  Then  Return 0
   Dim ffi As Long = InStr(ResImg, "|")
   if ffi > 0 Then ResImg = left(ResImg, ffi -1)
   Dim pa As String = GetProRunFile(0,4) & "images\" & ResImg
   nIcon = AfxGdipIconFromFile(StringToCWSTR(pa))

   Function = nIcon
End Function






















